home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Belgian Amiga Club - ADF Collection
/
BS1 part 21.zip
/
BS1 part 21
/
Professional Page v4.0 (1993)(Gold Disk)(Disk 1 of 4)[HD].7z
/
Professional Page v4.0 (1993)(Gold Disk)(Disk 1 of 4)[HD].adf
/
rexx.lzh
/
UnitsConverter.pprx
< prev
Wrap
Text File
|
1993-01-29
|
7KB
|
370 lines
/*
@BUnitsConverter @P@ICopyright Gold Disk Inc., February, 1992
UnitsConverter allows you to enter values in inches, points, picas, cm, ciceros, or agates, and convert to all other units.
*/
numeric digits 8
cr = '0a'x
dnumbers = " 1234567890."
numbers = " 1234567890"
signal on syntax
/* Check if math library is runnning. If not, try to load it */
if ~show('l', 'gdarexxsupport.library') then
do
if ~addlib('gdarexxsupport.library',0,-30,0) then
call exit_msg('Please Install gdarexxsupport.library in LIBS: directory')
end
/* start with decimal fraction of 1 inch */
dinches = 1
points = ""
inches = ""
pica = ""
cicero = ""
cent = ""
agates = ""
do forever
if inches ~= '' then
do
if verify(inches, " 1234567890./") ~= 0 then
call exit_msg('Invalid Entry')
dinch = ftod(inches)
end
else if dinches ~= '' then
do
if verify(dinches, dnumbers) ~= 0 then
call exit_msg('Invalid Entry')
dinch = dinches
end
else if pica ~= '' then
do
if verify(pica, " 1234567890.Pp") ~= 0 then
call exit_msg('Invalid Entry')
dinch = ptoint(pica)
end
else if points ~= '' then
do
if verify(points, " 1234567890.") ~= 0 then
call exit_msg('Invalid Entry')
dinch = points / 72
end
else if cent ~= '' then
do
if verify(cent, dnumbers) ~= 0 then
call exit_msg('Invalid Entry')
dinch = cent / 2.54
end
else if agates ~= '' then
do
if ~datatype(agates, n) then
call exit_msg('Invalid Entry')
dinch = agates / 14
end
else if cicero ~= '' then
do
if verify(cicero, " 1234567890Cc.") ~= 0 then
call exit_msg('Invalid Entry')
dinch = ctoint(cicero)
end
else
exit
if inches = '' then inches = dtof(dinch)
if dinches = '' then dinches = dinch
if cent = '' then cent = dinch * 2.54
if pica = '' then pica = itop(dinch)
if points = '' then points = dinch * 72
if cicero = '' then cicero = itoc(dinch)
if agates = '' then agates = (dinch * 14) % 1
form = "Fractional Inches:"inches || cr"Decimal Inches:"dinches || cr"Picas:"pica || cr"Points:"points || cr"Centimetres:"cent || cr"Ciceros:"cicero||cr"Agates:"agates
entry = ppm_GetForm("Conversion yields..", 18, form)
if entry = '' then exit
parse var entry ninches '0a'x ndinches '0a'x npicas '0a'x npoints '0a'x ncent '0a'x nciceros '0a'x nagates
if compare(ninches, inches) ~= 0 then
do
inches = ninches
pica = ''
cent = ''
points = ''
dinches = ''
cicero = ''
agates = ''
end
else if compare(dinches, ndinches ) ~= 0 then
do
dinches = ndinches
pica = ''
cent = ''
points = ''
inches = ''
agates = ''
cicero = ''
end
else if compare(pica, npicas ) ~= 0 then
do
pica = npicas
cent = ''
points = ''
inches = ''
dinches = ''
cicero = ''
agates = ''
end
else if compare(points, npoints ) ~= 0 then
do
cent = ''
points = npoints
pica = ''
inches = ''
dinches = ''
agates = ''
cicero = ''
end
else if compare(cent, ncent ) ~= 0 then
do
dinches = ''
pica = ''
cent = ncent
points = ''
inches = ''
agates = ''
cicero = ''
end
else if compare(cicero, nciceros) ~= 0 then
do
dinches = ''
pica = ''
cent = ''
points = ''
agates = ''
inches = ''
cicero = nciceros
end
else if compare(agates, nagates) ~= 0 then
do
dinches = ''
pica = ''
cent = ''
points = ''
inches = ''
cicero = ''
agates = nagates % 1
end
else exit
end
exit
exit_msg:
do
parse arg message
call ppm_Inform(1, message, )
exit
end
itop: procedure
do
arg iinches
picas = ppm_ConvertUnits(1, 3, iinches)
intpart = picas % 1
decpart = substr(picas, lastpos('.', picas) + 1)
return(intpart"p"decpart)
end
itoc: procedure
do
arg iinches
cpoints = iinches * 66.9566
cic = cpoints % 12
cpoints = cpoints - cic * 12
if cic < 1 then return("c"cpoints)
else return(cic"c"cpoints)
end
ptoint: procedure
do
arg entry
entry = upper(entry)
p = pos('P',entry)
if p = 0 then
do
if datatype(entry) ~= 'NUM' then exit_msg("Invalid entry")
return(entry / 6 )
end
else
do
points = substr(entry, p + 1)
picas = left(entry, p - 1)
if picas = '' then picas = 0
else if ~datatype(picas,n) then exit_msg("Invalid entry")
else picas = picas / 6
if points = '' then points = 0
else if datatype(points) ~= 'NUM' then exit_msg("Invalid entry")
else points = points / 72
return( picas + points )
end
end
ctoint: procedure
do
arg cic
c = pos('C',cic)
if c = 0 then c = pos('c', cic)
decimal = pos('.', cic )
if c = 0 then
do
return(cic * .1792 )
end
else
do
pcics = substr(cic, (c+1))
cic = strip(left(cic, c - 1))
if cic = '' then cic = 0
if pcics = '' then pcics = 0
else if pcics >= 12 then
do
cic = cic + pcics % 12
pcics = pcics // 12
end
iinches = cic * .1792 + pcics * .0149
return( iinches )
end
end
ftod: procedure
do
procedure expose dnumbers numbers
arg fraction
decimal = 0
wrdcnt = words( fraction )
if wrdcnt > 2 then
call exit_msg('Invalid Fraction entered')
else if wrdcnt = 2 then
do
decimal = word(fraction, 1)
if verify(decimal, dnumbers) ~= 0 then
call exit_msg('Invalid Fraction entered')
fraction = word(fraction, 2)
end
slash = pos('/', fraction )
if slash = 0 then
do
if datatype(fraction) ~= 'NUM' then exit_msg("Invalid entry")
else return(fraction)
end
if left(fraction, slash - 1 ) = 0 then signal syntax
if slash = 0 then
call exit_msg('Invalid Fraction entered')
interpret "decimal = decimal + "fraction
return( decimal )
end
dtof: procedure
do
arg decimal
xnumbers = "1234567890"
/* Convert a decimal number to a fraction with the precision
* of 1/72
*/
MAX = 72
tol = 1/MAX
point = pos('.', decimal )
if point = 0 then return( decimal )
integral = left(decimal, point - 1)
decimal = substr(decimal, point + 1 )
if verify(decimal, xnumbers ) ~= 0 then
exit_msg('Invalid Fraction entered')
curval = "."decimal
if curval < tol then return(integral)
do gcd = 1 to ( MAX - 1 )
n = gcd * curval
if abs(n - nint(n)) < tol then leave
end
numerator = max(nint(gcd * curval) % 1, 1 )
if gcd = 1 then
do
if integral = '' then integral = 0
return( integral + numerator )
end
return( integral" "numerator"/"gcd )
end
syntax:
do
exit_msg("Genie failed due to error: "errortext(rc)" Line "SIGL)
end